home *** CD-ROM | disk | FTP | other *** search
/ Risc World 9 / Risc World 9.iso / HTML / ISSUE6 / WIMPPROG / Listings / pg168.txt < prev    next >
Text File  |  2005-01-09  |  12KB  |  467 lines
  1.  REM >!RunImage
  2.  REM (C) Martyn Fox
  3.  REM shape drawing program
  4.  REM based on Wimp shell program v0.01
  5.  version$="0.01 (date)"
  6.  ON ERROR PROCclose:REPORT:PRINT" at line ";ERL:END
  7.  SYS "Wimp_Initialise",200,&4B534154,"Shapes" TO ,task%
  8.  PROCinit
  9.  PROCcreateicon
  10.  ON ERROR IF FNerror THEN PROCclose:END
  11.  REPEAT
  12.    PROCpoll
  13.  UNTIL quit%
  14.  PROCclose
  15.  END
  16.  :
  17.  DEFPROCcreateicon
  18.  REM creates the application's icon and puts it on the icon bar
  19.  !b%=-1:b%!4=0:b%!8=0:b%!12=68:b%!16=68:b%!20=&3002
  20.  $(b%+24)="!shapes":SYS"Wimp_CreateIcon",,b% TO i%
  21.  ENDPROC
  22.  :
  23.  DEFPROCclose
  24.  REM tells the Wimp to quit the application
  25.  SYS "Wimp_CloseDown",task%,&4B534154
  26.  ENDPROC
  27.  :
  28.  DEFPROCpoll
  29.  REM main program Wimp polling loop
  30.  SYS "Wimp_Poll",,b% TO r%
  31.  CASE r% OF
  32.    WHEN 1:PROCredraw(b%)
  33.    WHEN 2:SYS "Wimp_OpenWindow",,b%
  34.    WHEN 3:SYS "Wimp_CloseWindow",,b%
  35.    WHEN 6:PROCmouseclick
  36.    WHEN 7:PROCdragend
  37.    WHEN 8:PROCkeypress
  38.    WHEN 9:PROCmenuclick
  39.    WHEN 17,18:PROCreceive
  40.  ENDCASE
  41.  ENDPROC
  42.  :
  43.  DEFPROCmouseclick
  44.  REM handles mouse clicks in response to Wimp_Poll reason code 6
  45.  REM b%!0=mousex,b%!4=mousey:b%!8=buttons:b%!12=window handle (-2 for icon bar):b%!16=icon handle
  46.  CASE b%!12 OF
  47.    WHEN -2:CASE b%!8 OF
  48.      WHEN 2:PROCshowmenu(mainmenu%,!b%-64,96+2*44):REM replace '2' with number of main menu items
  49.      WHEN 4:!b%=main%:SYS "Wimp_GetWindowState",,b%:b%!28=-1:SYS "Wimp_OpenWindow",,b%
  50.    ENDCASE
  51.    WHEN main%:PROCwindow_click
  52.    WHEN options%:PROCopt_box(b%!8,b%!16)
  53.    WHEN saveas%:PROCsavebox
  54.  ENDCASE
  55.  ENDPROC
  56.  :
  57.  DEFPROCget_origin(handle%,RETURN xorig%,RETURN yorig%)
  58.  REM returns coordinates of window work area origin
  59.  LOCAL c%
  60.  c%=FNstack(36)
  61.  !c%=handle%
  62.  SYS "Wimp_GetWindowState",,c%
  63.  xorig%=c%!4-c%!20:yorig%=c%!16-c%!24
  64.  PROCunstack(c%)
  65.  ENDPROC
  66.  :
  67.  DEFFNstack(size%)
  68.  REM allocates temporary memory from stack block
  69.  REM stack must be cleared after use with PROCunstack
  70.  IF stackptr%+size%>stackend%  ERROR 1,"No room in stack"
  71.  stackptr%+=size%
  72.  =stackptr%-size%
  73.  :
  74.  DEFPROCunstack(old_ptr%)
  75.  REM removes temporary memory from stack
  76.  stackptr%=old_ptr%
  77.  IF stackptr%<stack% stackptr%=stack%
  78.  ENDPROC
  79.  :
  80.  DEFFNmake_menu
  81.  REM creates menu block from DATA statements
  82.  LOCAL start%,title$,item$,ul%,tail$,writable%,buffer%,buflen%
  83.  start%=menspc%
  84.  READ title$
  85.  $(start%)=title$
  86.  start%?12=7:REM title foreground colour
  87.  start%?13=2:REM title background colour
  88.  start%?14=7:REM work area foreground colour
  89.  start%?15=0:REM work area background colour
  90.  start%!20=44:REM height of menu items
  91.  start%!24=0:REM gap between items
  92.  width%=LEN(title$)-3
  93.  menspc%+=28
  94.  REPEAT
  95.    READ item$
  96.    IF item$<>"*" THEN
  97.      !menspc%=0
  98.      writable%=FALSE
  99.      ul%=INSTR(item$,"_")
  100.      IF ul% THEN
  101.        tail$=RIGHT$(item$,LEN(item$)-ul%)
  102.        IF INSTR(tail$,"T") !menspc%=!menspc% OR 1:REM tick
  103.        IF INSTR(tail$,"D") !menspc%=!menspc% OR 2:REM dotted line
  104.        IF INSTR(tail$,"W") !menspc%=!menspc% OR 4:writable%=TRUE:READ buffer%:READ buflen%:REM writable icon
  105.        IF INSTR(tail$,"M") !menspc%=!menspc% OR 8:REM generate message
  106.        item$=LEFT$(item$,ul%-1)
  107.      ENDIF
  108.      IF LENitem$>width% width%=LENitem$
  109.      menspc%!4=-1:REM submenu ptr
  110.      IF writable% THEN
  111.        menspc%!8=&0700F121:menspc%!12=buffer%:menspc%!16=-1:menspc%!20=buflen%:$buffer%=item$
  112.        ELSE
  113.        IF LENitem$<12 THEN
  114.          menspc%!8=&07000021:$(menspc%+12)=item$
  115.          ELSE
  116.          menspc%!8=&07000121:menspc%!12=ws%:menspc%!16=-1:menspc%!20=LENitem$+1
  117.          $ws%=item$:ws%+=LENitem$+1
  118.        ENDIF
  119.      ENDIF
  120.      menspc%+=24
  121.    ENDIF
  122.  UNTIL item$="*"
  123.  start%!16=width%*16+32
  124.  !(menspc%-24)=!(menspc%-24) OR &80
  125.  mptr%=menspc%
  126.  =start%
  127.  :
  128.  DEFPROCload_templates
  129.  REM opens window template file, loads and creates window
  130.  SYS "Wimp_OpenTemplate",,"<Shapes$Dir>.Templates"
  131.  REM ****** load and create Info box ******
  132.  SYS "Wimp_LoadTemplate",,stack%,ws%,wsend%,-1,"progInfo",0 TO ,,ws%
  133.  $stack%!(88+32*0+20)=version$
  134.  SYS "Wimp_CreateWindow",,stack% TO info%
  135.  REM ****** load and create main window ******
  136.  SYS "Wimp_LoadTemplate",,stack%,ws%,wsend%,-1,"Main",0 TO ,,ws%
  137.  SYS "Wimp_CreateWindow",,stack% TO main%
  138.  REM ****** load and create Options dialogue box ******
  139.  SYS "Wimp_LoadTemplate",,stack%,ws%,wsend%,-1,"Options",0 TO ,,ws%
  140.  SYS "Wimp_CreateWindow",,stack% TO options%
  141.  REM ****** load and create Save box ******
  142.  SYS "Wimp_LoadTemplate",,stack%,ws%,wsend%,-1,"xfer_send",0 TO ,,ws%
  143.  savestr%=!(stack%+88+32*2+20)
  144.  SYS "Wimp_CreateWindow",,stack% TO saveas%
  145.  REM ****** end of window creation ******
  146.  SYS "Wimp_CloseTemplate"
  147.  ENDPROC
  148.  :
  149.  DEFPROCattach(menu%,item%,sub%)
  150.  REM attach submenu or dialogue box to main menu
  151.  !(menu%+28+item%*24+4)=sub%
  152.  ENDPROC
  153.  :
  154.  DEFPROCinit
  155.  REM initialisation before polling loop starts
  156.  DIM b% 255,ws% 1023,menspc% 1023,stack% 1023,list% 1023
  157.  wsend%=ws%+1024:stackend%=stack%+1024:stackptr%=stack%
  158.  quit%=FALSE
  159.  !list%=-1
  160.  colsel%=7
  161.  PROCload_templates
  162.  PROCmenus
  163.  !b%=main%:SYS "Wimp_GetWindowState",,b%:SYS "Wimp_OpenWindow",,b%
  164.  ENDPROC
  165.  :
  166.  DEFPROCreceive
  167.  REM handles messages received from the Wimp with reason codes 17 or 18
  168.  CASE b%!16 OF
  169.    WHEN 0:quit%=TRUE
  170.    WHEN 2:PROCsave
  171.    WHEN 3:PROCload
  172.  ENDCASE
  173.  ENDPROC
  174.  :
  175.  DEFPROCwindow_click
  176.  REM handles mouse clicks on window
  177.  REM b%!0=mousex,b%!4=mousey:b%!8=buttons:b%!12=window handle (-2 for icon bar):b%!16=icon handle
  178.  CASE b%!8 OF
  179.    WHEN 2:PROCshowmenu(wmenu%,!b%,b%!4)
  180.    WHEN 1:PROCdelete_item
  181.    WHEN 4:PROCadd_item
  182.  ENDCASE
  183.  ENDPROC
  184.  :
  185.  DEFPROCmenus
  186.  REM create menus and attach submenus and dialogue boxes
  187.  PROCmain_menu
  188.  PROCattach(mainmenu%,0,info%)
  189.  PROCwindow_menu
  190.  PROCattach(wmenu%,0,options%)
  191.  PROCattach(wmenu%,2,saveas%)
  192.  $savestr%="ShapeFile"
  193.  ENDPROC
  194.  :
  195.  DEFPROCshowmenu(menu%,x%,y%)
  196.  REM opens menu at given coordinates
  197.  topmenu%=menu%:topx%=x%:topy%=y%
  198.  SYS "Wimp_CreateMenu",,menu%,x%,y%
  199.  ENDPROC
  200.  :
  201.  DEFPROCmenuclick
  202.  REM handles mouse clicks on menu in response to Wimp_Poll reason code 9
  203.  LOCAL c%,adj%
  204.  c%=FNstack(20)
  205.  SYS "Wimp_GetPointerInfo",,c%
  206.  adj%=(c%!8 AND 1)
  207.  SYS "Wimp_DecodeMenu",,topmenu%,b%,c%
  208.  CASE $c% OF
  209.    WHEN "Quit":quit%=TRUE
  210.    WHEN "Clear":PROCclear
  211.    WHEN "Save":PROCsave
  212.  ENDCASE
  213.  IF adj% PROCshowmenu(topmenu%,topx%,topy%)
  214.  PROCunstack(c%)
  215.  ENDPROC
  216.  :
  217.  DEFPROCmain_menu
  218.  REM creates main menu, calling FNmake_menu
  219.  RESTORE +1
  220.  DATA Shapes,Info,Quit,*
  221.  mainmenu%=FNmake_menu
  222.  ENDPROC
  223.  :
  224.  DEFPROCredraw(b%)
  225.  REM redraws window contents
  226.  LOCAL xorig%,yorig%,more%
  227.  PROCget_origin(!b%,xorig%,yorig%)
  228.  SYS "Wimp_RedrawWindow",,b% TO more%
  229.  WHILE more%
  230.    PROCdraw(b%,xorig%,yorig%)
  231.    SYS "Wimp_GetRectangle",,b% TO more%
  232.  ENDWHILE
  233.  ENDPROC
  234.  :
  235.  DEFPROCdraw(b%,xorig%,yorig%)
  236.  REM called when all or part of window needs redrawing
  237.  REM xorig% and yorig% are coordinates of work area origin (top left-hand corner of window work area)
  238.  REM b% points to block:
  239.  REM b%!0  : window handle
  240.  REM b%!4  : visible area minimum x coordinate
  241.  REM b%!8  : visible area minimum y coordinate
  242.  REM b%!12 : visible area maximum x coordinate
  243.  REM b%!16 : visible area maximum y coordinate
  244.  REM b%!20 : scroll x offset relative to work area origin
  245.  REM b%!24 : scroll y offset relative to work area origin
  246.  REM b%!28 : current graphics window minimum x coordinate
  247.  REM b%!32 : current graphics window minimum y coordinate
  248.  REM b%!36 : current graphics window maximum x coordinate
  249.  REM b%!40 : current graphics window maximum y coordinate
  250.  LOCAL coords%,colour%,plot%
  251.  MOVE xorig%,yorig%
  252.  coords%=list%
  253.  WHILE !coords%<>-1
  254.    PROCplot_shape(!coords%,x%,y%,colour%,plot%)
  255.    SYS "Wimp_SetColour",colour%
  256.    PLOT plot%,xorig%+x%,yorig%-y%
  257.    coords%+=4
  258.  ENDWHILE
  259.  ENDPROC
  260.  :
  261.  DEFPROCplot_shape(word%,RETURN x%,RETURN y%,RETURN colour%,RETURN plot%)
  262.  REM returns parameters of object to be plotted, decoded from word%
  263.  x%=(word% AND &3FF)*4:y%=(word%>>12) AND &FFC
  264.  colour%=(word%>>10) AND &F
  265.  plot%=(word%>>24) AND &FF
  266.  ENDPROC
  267.  :
  268.  DEFPROCwindow_menu
  269.  RESTORE +1
  270.  DATA Shapes,Options,Clear,Save,*
  271.  wmenu%=FNmake_menu
  272.  ENDPROC
  273.  :
  274.  DEFFNicon_state(window%,icon%)
  275.  LOCAL c%
  276.  c%=FNstack(40)
  277.  !c%=window%
  278.  c%!4=icon%
  279.  SYS "Wimp_GetIconState",,c%
  280.  PROCunstack(c%)
  281.  =((c%!24) AND (1<<21))<>0
  282.  :
  283.  DEFPROCadd_item
  284.  x%=!b%:y%=b%!4
  285.  PROCget_origin(main%,xorig%,yorig%)
  286.  coords%=FNend
  287.  IF coords%<list%+1020 THEN
  288.  CASE TRUE OF
  289.    WHEN FNicon_state(options%,0):plot%=4:REM MOVE
  290.    WHEN FNicon_state(options%,1):plot%=5:REM DRAW
  291.    WHEN FNicon_state(options%,2):plot%=157:REM CIRCLE FILL
  292.    WHEN FNicon_state(options%,3):plot%=101:REM RECTANGLE FILL
  293.    OTHERWISE:plot%=4:REM MOVE - all icons deselected
  294.  ENDCASE
  295.  !coords%=(((x%-xorig%) AND &FFC) DIV 4)+((yorig%-y%) AND &FFC)*(1<<12)+(colsel% AND &F)*(1<<10)
  296.  coords%?3=plot%
  297.  coords%!4=-1
  298.  PROCforce_redraw(main%)
  299.  ENDIF
  300.  ENDPROC
  301.  :
  302.  DEFFNend
  303.  LOCAL n%
  304.  n%=list%
  305.  WHILE !n%<>-1
  306.    n%+=4
  307.  ENDWHILE
  308.  =n%
  309.  :
  310.  DEFPROCforce_redraw(window%)
  311.  LOCAL c%
  312.  c%=FNstack(36)
  313.  !c%=window%
  314.  SYS "Wimp_GetWindowState",,c%
  315.  SYS "Wimp_ForceRedraw",-1,c%!4,c%!8,c%!12,c%!16
  316.  PROCunstack(c%)
  317.  ENDPROC
  318.  :
  319.  DEFPROCdelete_item
  320.  coords%=FNend
  321.  IF coords%>list% coords%-=4:!coords%=-1 ELSE VDU 7
  322.  PROCforce_redraw(main%)
  323.  ENDPROC
  324.  :
  325.  DEFPROCopt_box(button%,icon%)
  326.  CASE icon% OF
  327.    WHEN 0,1,2,3:
  328.    WHEN 5:
  329.      !b%=options%:b%!4=4
  330.      SYS "Wimp_GetIconState",,b%
  331.      colsel%=(b%!24)>>28
  332.      IF button%=4 SYS "Wimp_CreateMenu",,-1
  333.    OTHERWISE
  334.      !b%=options%:b%!4=icon%
  335.      SYS "Wimp_GetIconState",,b%
  336.      b%!4=4:b%!8=(b%!24) AND &F<<28:b%!12=&F<<28
  337.      SYS "Wimp_SetIconState",,b%
  338.  ENDCASE
  339.  ENDPROC
  340.  :
  341.  DEFPROCclear
  342.  !list%=-1
  343.  PROCforce_redraw(main%)
  344.  ENDPROC
  345.  :
  346.  DEFFNerror
  347.  !b%=ERR
  348.  CASE !b% OF
  349.  WHEN 1<<30:err_str$="":box%=3
  350.  OTHERWISE:err_str$=" at line "+STR$ERL:box%=2
  351.  ENDCASE
  352.  $(b%+4)=REPORT$+err_str$+CHR$0
  353.  SYS "Wimp_ReportError",b%,box%,"Shapes" TO ,response%
  354.  =(response%=2)
  355.  :
  356.  DEFPROCload
  357.  IF b%!40<>&012 ERROR 1<<30,"Filetype not recognised"
  358.  PROCterm(b%+44)
  359.  SYS "XOS_CLI","LOAD "+$(b%+44)+" "+STR$~list% TO err%;flags%
  360.  IF (flags% AND 1)<>0 !err%=1<<30:SYS "OS_GenerateError",err%
  361.  b%!12=b%!8
  362.  b%!16=4:REM Message_DataLoadAck
  363.  SYS "Wimp_SendMessage",17,b%,b%!4
  364.  $savestr%=$(b%+44)
  365.  !b%=main%
  366.  SYS "Wimp_GetWindowState",,b%
  367.  IF ((b%!32) AND 1<<16)=0 THEN
  368.    SYS "Wimp_OpenWindow",,b%
  369.  ELSE
  370.    PROCforce_redraw(main%)
  371.  ENDIF
  372.  ENDPROC
  373.  :
  374.  DEFPROCterm(a%)
  375.  LOCAL n%
  376.  WHILE a%?n%>31
  377.    n%+=1
  378.  ENDWHILE
  379.  a%?n%=13
  380.  ENDPROC
  381.  :
  382.  DEFPROCsavebox
  383.  CASE b%!16 OF
  384.    WHEN 0:IF b%!8=1 OR b%!8=4 THEN PROCchecksave
  385.    WHEN 1:IF b%!8=16 OR b%!8=64 THEN PROCdrag(b%!12,1)
  386.  ENDCASE
  387.  ENDPROC
  388.  :
  389.  DEFPROCdrag(window%,icon%)
  390.  LOCAL c%
  391.  c%=FNstack(56)
  392.  PROCget_origin(window%,xorig%,yorig%)
  393.  !c%=window%:c%!4=icon%
  394.  SYS "Wimp_GetIconState",,c%
  395.  xmin%=xorig%+c%!8:ymin%=yorig%+c%!12:xmax%=xorig%+c%!16:ymax%=yorig%+c%!20
  396.  c%!4=5:REM drag type
  397.  c%!8=xmin%:REM coordinates of drag box
  398.  c%!12=ymin%
  399.  c%!16=xmax%
  400.  c%!20=ymax%
  401.  c%!24=0:REM screen min x
  402.  c%!28=0:REM screen min y
  403.  c%!32=4096:REM screen max x
  404.  c%!36=3072:REM screen max y
  405.  SYS "Wimp_DragBox",,c%
  406.  PROCunstack(c%)
  407.  ENDPROC
  408.  :
  409.  DEFPROCdragend
  410.  SYS "Wimp_GetPointerInfo",,b%
  411.  b%!20=b%!12:REM destination window handle
  412.  b%!24=b%!16:REM destination icon handle
  413.  b%!28=b%!0:REM destination x coordinate
  414.  b%!32=b%!4:REM destination y coordinate
  415.  b%!36=FNend+4-list%:REM length of data
  416.  a$=$savestr%:REM get leafname
  417.  WHILE INSTR(a$,".")<>0
  418.    n%=INSTR(a$,".")
  419.    a$=MID$(a$,n%+1)
  420.  ENDWHILE
  421.  $(b%+44)=a$:REM leafname of file
  422.  !b%=44+((LENa$+1) DIV 4)*4:REM length of block
  423.  IF ((LENa$+1) MOD 4)<>0 !b%+=4
  424.  b%!12=0:REM your_ref for original message
  425.  b%!16=1:REM Message_DataSave
  426.  SYS "Wimp_SendMessage",18,b%,b%!20
  427.  ENDPROC
  428.  :
  429.  DEFPROCsave
  430.  PROCterm(b%+44)
  431.  $savestr%=$(b%+44)
  432.  PROCsave2
  433.  b%!12=b%!8
  434.  b%!16=3:REM Message_DataLoad
  435.  SYS "Wimp_SendMessage",18,b%,b%!20
  436.  ENDPROC
  437.  :
  438.  DEFPROCsave2
  439.  n%=FNend+4
  440.  SYS "XOS_CLI","SAVE "+$savestr%+" "+STR$~list%+" "+STR$~n% TO err%;flags%
  441.  IF (flags% AND 1)<>0 !err%=1<<30:SYS "OS_GenerateError",err%
  442.  SYS "XOS_CLI","SETTYPE "+$savestr%+" 012" TO err%;flags%
  443.  IF (flags% AND 1)<>0 !err%=1<<30:SYS "OS_GenerateError",err%
  444.  SYS "Wimp_CreateMenu",,-1
  445.  ENDPROC
  446.  :
  447.  DEFPROCchecksave
  448.  IF INSTR($savestr%,"::")<>0 AND INSTR($savestr%,"$.")<>0 THEN
  449.    PROCsave2
  450.  ELSE
  451.    SYS "Wimp_CreateMenu",,-1
  452.    ERROR 1<<30,"To save, drag the icon to a directory display"
  453.  ENDIF
  454.  ENDPROC
  455.  :
  456.  DEFPROCkeypress
  457.  REM processes keypresses in response to Wimp_Poll reason code 8
  458.  IF b%!24=13 THEN
  459.    !b%=saveas%
  460.    SYS "Wimp_GetWindowState",,b%
  461.    IF (b%!32 AND 1<<16)<>0 THEN PROCchecksave
  462.  ELSE
  463.    SYS "Wimp_ProcessKey",b%!24
  464.  ENDIF
  465.  ENDPROC
  466.  :
  467.